home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / primitives.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-16  |  19.1 KB  |  468 lines
  1. /*
  2.  *
  3.  * p r i m i t i v e s . c            -- List of STk subrs
  4.  *
  5.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  6.  * 
  7.  *
  8.  * Permission to use, copy, and/or distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that both the above copyright notice and this permission notice appear in
  11.  * all copies and derived works.  Fees for distribution or use of this
  12.  * software or derived works may only be charged with express written
  13.  * permission of the copyright holder.  
  14.  * This software is provided ``as is'' without express or implied warranty.
  15.  *
  16.  * This software is a derivative work of other copyrighted softwares; the
  17.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  18.  *
  19.  *
  20.  *           Author: Erick Gallesio [eg@kaolin.unice.fr]
  21.  *    Creation date: ??????
  22.  * Last file update: 16-Jun-1996 22:54
  23.  */
  24.  
  25.  
  26. #include "stk.h"
  27.  
  28. struct Primitive {
  29.   char *name;
  30.   char type;
  31.   PRIMITIVE (*fct)();
  32. };
  33.  
  34. #ifdef USE_HASH
  35. extern PRIMITIVE STk_init_hash(void);
  36. #endif
  37. #ifdef USE_SOCKET
  38. extern PRIMITIVE STk_init_socket(void);
  39. #endif
  40. #ifdef USE_BLT
  41. extern PRIMITIVE STk_init_blt(void);
  42. #endif
  43. #ifdef USE_REGEXP
  44. extern PRIMITIVE STk_init_sregexp(void);
  45. #endif
  46. #ifdef USE_PROCESS
  47. extern PRIMITIVE STk_init_process(void);
  48. #endif
  49. #ifdef USE_POSIX
  50. extern PRIMITIVE STk_init_posix(void);
  51. #endif
  52. #ifdef USE_HTML
  53. extern PRIMITIVE STk_init_html(void);
  54. #endif
  55. #ifdef USE_PIXMAP
  56. extern PRIMITIVE STk_init_pixmap(void);
  57. #endif
  58.  
  59. static struct Primitive Scheme_primitives[] = { 
  60.  
  61.   /**** Section 4.1 ****/
  62.   {"quote",            tc_syntax,        STk_syntax_quote},
  63.   {"lambda",            tc_syntax,        STk_syntax_lambda},
  64.   {"if",            tc_syntax,        STk_syntax_if},
  65.   {"set!",            tc_syntax,        STk_syntax_setq},
  66.   
  67.   /**** Section 4.2 ****/
  68.   {"cond",            tc_syntax,        STk_syntax_cond},
  69.   {"and",            tc_syntax,        STk_syntax_and},
  70.   {"or",            tc_syntax,        STk_syntax_or},
  71.   {"let",            tc_syntax,        STk_syntax_let},
  72.   {"let*",            tc_syntax,        STk_syntax_letstar},
  73.   {"letrec",            tc_syntax,        STk_syntax_letrec},
  74.   {"begin",            tc_syntax,        STk_syntax_begin},
  75.   {"delay",            tc_syntax,        STk_syntax_delay},
  76.   {"quasiquote",        tc_syntax,        STk_syntax_quasiquote},
  77.   {"while",            tc_fsubr,        STk_while},        
  78.   {"until",            tc_fsubr,        STk_until},        
  79.   {"extend-environment",    tc_syntax,        STk_syntax_extend_env},    /* + */
  80.  
  81.  
  82.   /**** Section 5 ****/
  83.   {"define",            tc_syntax,        STk_syntax_define},
  84.  
  85.   /**** Section 6.1 ****/
  86.   {"boolean?",            tc_subr_1,      STk_booleanp},
  87.   {"not",            tc_subr_1,      STk_not},
  88.  
  89.   /**** Section 6.2 ****/
  90.   {"eq?",            tc_subr_2,      STk_eq},
  91.   {"eqv?",            tc_subr_2,      STk_eqv},
  92.   {"equal?",            tc_subr_2,      STk_equal},
  93.  
  94.   /**** Section 6.3 ****/
  95.   {"pair?",            tc_subr_1,      STk_pairp},
  96.   {"cons",            tc_subr_2,      STk_cons},
  97.   {"car",            tc_subr_1,      STk_car},
  98.   {"cdr",            tc_subr_1,      STk_cdr},
  99.   {"set-car!",            tc_subr_2,      STk_setcar},
  100.   {"set-cdr!",            tc_subr_2,      STk_setcdr},
  101.   {"caar",            tc_subr_1,      STk_caar},
  102.   {"cdar",            tc_subr_1,      STk_cdar},
  103.   {"cadr",            tc_subr_1,      STk_cadr},
  104.   {"cddr",            tc_subr_1,      STk_cddr},
  105.   {"caaar",            tc_subr_1,      STk_caaar},
  106.   {"cdaar",            tc_subr_1,      STk_cdaar},
  107.   {"cadar",            tc_subr_1,      STk_cadar},
  108.   {"cddar",            tc_subr_1,      STk_cddar},
  109.   {"caadr",            tc_subr_1,      STk_caadr},
  110.   {"cdadr",            tc_subr_1,      STk_cdadr},
  111.   {"caddr",            tc_subr_1,      STk_caddr},
  112.   {"cdddr",            tc_subr_1,      STk_cdddr},
  113.   {"caaaar",            tc_subr_1,      STk_caaaar},
  114.   {"cdaaar",            tc_subr_1,      STk_cdaaar},
  115.   {"cadaar",            tc_subr_1,      STk_cadaar},
  116.   {"cddaar",            tc_subr_1,      STk_cddaar},
  117.   {"caadar",            tc_subr_1,      STk_caadar},
  118.   {"cdadar",            tc_subr_1,      STk_cdadar},
  119.   {"caddar",            tc_subr_1,      STk_caddar},
  120.   {"cdddar",            tc_subr_1,      STk_cdddar},
  121.   {"caaadr",            tc_subr_1,      STk_caaadr},
  122.   {"cdaadr",            tc_subr_1,      STk_cdaadr},
  123.   {"cadadr",            tc_subr_1,      STk_cadadr},
  124.   {"cddadr",            tc_subr_1,      STk_cddadr},
  125.   {"caaddr",            tc_subr_1,      STk_caaddr},
  126.   {"cdaddr",            tc_subr_1,      STk_cdaddr},
  127.   {"cadddr",            tc_subr_1,      STk_cadddr},
  128.   {"cddddr",            tc_subr_1,      STk_cddddr},
  129.   {"null?",            tc_subr_1,      STk_nullp},
  130.   {"list?",            tc_subr_1,      STk_listp},
  131.   {"list",            tc_lsubr,       STk_list},
  132.   {"length",            tc_subr_1,      STk_list_length},
  133.   {"append",            tc_lsubr,       STk_append},
  134.   {"reverse",            tc_subr_1,      STk_reverse},
  135.   {"list-tail",            tc_subr_2,      STk_list_tail},
  136.   {"list-ref",            tc_subr_2,      STk_list_ref},
  137.   {"memq",            tc_subr_2,      STk_memq},
  138.   {"memv",            tc_subr_2,      STk_memv},
  139.   {"member",            tc_subr_2,      STk_member},
  140.   {"assq",            tc_subr_2,      STk_assq},
  141.   {"assv",            tc_subr_2,      STk_assv},
  142.   {"assoc",            tc_subr_2,      STk_assoc},
  143.  
  144.   {"list*",            tc_lsubr,       STk_liststar},        /* + */
  145.   {"copy-tree",            tc_subr_1,        STk_copy_tree},        /* + */
  146.  
  147.   /**** Section 6.4 ****/
  148.   {"symbol?",            tc_subr_1,        STk_symbolp},
  149.   {"symbol->string",        tc_subr_1,        STk_symbol2string},
  150.   {"string->symbol",        tc_subr_1,        STk_string2symbol},
  151.  
  152.   /**** Section 6.5 ****/
  153.   {"number?",            tc_subr_1,        STk_numberp},
  154.   {"complex?",            tc_subr_1,        STk_numberp},
  155.   {"real?",            tc_subr_1,        STk_numberp},
  156.   {"rational?",            tc_subr_1,        STk_numberp},
  157.   {"integer?",            tc_subr_1,        STk_integerp},
  158.   {"exact?",            tc_subr_1,        STk_exactp},
  159.   {"inexact?",            tc_subr_1,        STk_inexactp},
  160.   {"=",                tc_ssubr,        STk_numequal},
  161.   {"<",                tc_ssubr,        STk_lessp},      
  162.   {">",                tc_ssubr,        STk_greaterp},
  163.   {"<=",            tc_ssubr,        STk_lessep},
  164.   {">=",            tc_ssubr,        STk_greaterep},
  165.   {"zero?",            tc_subr_1,        STk_zerop},
  166.   {"negative?",            tc_subr_1,        STk_negativep},
  167.   {"positive?",            tc_subr_1,        STk_positivep},
  168.   {"odd?",            tc_subr_1,        STk_oddp},
  169.   {"even?",            tc_subr_1,        STk_evenp},
  170.   {"max",            tc_ssubr,        STk_max},
  171.   {"min",            tc_ssubr,        STk_min},
  172.   {"+",                tc_ssubr,        STk_plus},
  173.   {"-",                tc_ssubr,        STk_difference},
  174.   {"*",                tc_ssubr,        STk_times},
  175.   {"/",                tc_ssubr,        STk_division},
  176.   {"abs",            tc_subr_1,        STk_absolute},
  177.   {"quotient",            tc_subr_2,        STk_quotient},
  178.   {"remainder",            tc_subr_2,        STk_remainder},
  179.   {"modulo",            tc_subr_2,        STk_modulo},
  180.   {"gcd",            tc_ssubr,        STk_gcd},
  181.   {"lcm",            tc_ssubr,        STk_lcm},
  182.   {"floor",            tc_subr_1,        STk_floor},
  183.   {"ceiling",            tc_subr_1,        STk_ceiling},
  184.   {"truncate",            tc_subr_1,        STk_truncate},
  185.   {"round",            tc_subr_1,        STk_round},
  186.   {"exp",            tc_subr_1,        STk_exp},
  187.   {"log",            tc_subr_1,        STk_log},
  188.   {"sin",            tc_subr_1,        STk_sin},
  189.   {"cos",            tc_subr_1,        STk_cos},
  190.   {"tan",            tc_subr_1,        STk_tan},
  191.   {"asin",            tc_subr_1,        STk_asin},
  192.   {"acos",            tc_subr_1,        STk_acos},
  193.   {"atan",            tc_subr_1_or_2, STk_atan},
  194.   {"sqrt",            tc_subr_1,        STk_sqrt},
  195.   {"expt",            tc_subr_2,        STk_expt},
  196.   {"exact->inexact",        tc_subr_1,        STk_exact2inexact},
  197.   {"inexact->exact",        tc_subr_1,        STk_inexact2exact},
  198.   {"string->number",        tc_subr_1_or_2, STk_string2number},
  199.   {"number->string",        tc_subr_1_or_2, STk_number2string},
  200.   {"bignum?",            tc_subr_1,        STk_bignump},        /* + */
  201.  
  202.   /**** Section 6.6 ****/
  203.   {"char?",            tc_subr_1,        STk_charp},
  204.  
  205.   {"char=?",            tc_subr_2,        STk_chareq},
  206.   {"char<?",            tc_subr_2,        STk_charless},
  207.   {"char>?",            tc_subr_2,        STk_chargt},
  208.   {"char<=?",            tc_subr_2,        STk_charlesse},
  209.   {"char>=?",            tc_subr_2,        STk_chargte},
  210.  
  211.   {"char-ci=?",            tc_subr_2,        STk_chareqi},
  212.   {"char-ci<?",            tc_subr_2,        STk_charlessi},
  213.   {"char-ci>?",            tc_subr_2,        STk_chargti},
  214.   {"char-ci<=?",        tc_subr_2,        STk_charlessei},
  215.   {"char-ci>=?",        tc_subr_2,        STk_chargtei},
  216.   
  217.   {"char-alphabetic?",        tc_subr_1,        STk_char_alphap},
  218.   {"char-numeric?",        tc_subr_1,        STk_char_numericp},
  219.   {"char-whitespace?",        tc_subr_1,        STk_char_whitep},
  220.   {"char-upper-case?",        tc_subr_1,        STk_char_upperp},
  221.   {"char-lower-case?",        tc_subr_1,        STk_char_lowerp},
  222.   
  223.   {"integer->char",        tc_subr_1,        STk_integer2char},
  224.   {"char->integer",        tc_subr_1,        STk_char2integer},
  225.   {"char-upcase",        tc_subr_1,        STk_char_upper},
  226.   {"char-downcase",        tc_subr_1,        STk_char_lower},
  227.  
  228.   /**** Section 6.7 ****/
  229.   {"string?",            tc_subr_1,        STk_stringp},
  230.  
  231.   {"make-string",        tc_subr_1_or_2, STk_make_string},
  232.   {"string",            tc_lsubr,        STk_lstring},
  233.   {"string-length",        tc_subr_1,        STk_string_length},
  234.   {"string-ref",        tc_subr_2,        STk_string_ref},
  235.   {"string-set!",        tc_subr_3,        STk_string_set},
  236.  
  237.   {"string=?",            tc_subr_2,        STk_streq},
  238.   {"string<?",            tc_subr_2,        STk_strless},
  239.   {"string>?",            tc_subr_2,        STk_strgt},
  240.   {"string<=?",            tc_subr_2,        STk_strlesse},
  241.   {"string>=?",            tc_subr_2,        STk_strgte},
  242.  
  243.   {"string-ci=?",        tc_subr_2,        STk_streqi},
  244.   {"string-ci<?",        tc_subr_2,        STk_strlessi},
  245.   {"string-ci>?",        tc_subr_2,        STk_strgti},
  246.   {"string-ci<=?",        tc_subr_2,        STk_strlessei},
  247.   {"string-ci>=?",        tc_subr_2,        STk_strgtei},
  248.  
  249.   {"substring",            tc_subr_3,        STk_substring},
  250.   {"string-append",        tc_lsubr,        STk_string_append},
  251.   {"string->list",        tc_subr_1,        STk_string2list},
  252.   {"list->string",        tc_subr_1,        STk_list2string},
  253.   {"string-copy",        tc_subr_1,        STk_string_copy},
  254.   {"string-fill!",        tc_subr_2,        STk_string_fill},
  255.  
  256.   {"string-find?",        tc_subr_2,        STk_string_findp},        /* + */
  257.   {"string-index",        tc_subr_2,        STk_string_index},        /* + */
  258.   {"string-lower",        tc_subr_1,        STk_string_lower},        /* + */
  259.   {"string-upper",        tc_subr_1,        STk_string_upper},        /* + */
  260.  
  261.  
  262.   /**** Section 6.8 ****/
  263.   {"vector?",            tc_subr_1,        STk_vectorp},
  264.   {"make-vector",        tc_subr_1_or_2, STk_make_vector},
  265.   {"vector",            tc_lsubr,        STk_vector},
  266.   {"vector-length",        tc_subr_1,        STk_vector_length},
  267.   {"vector-ref",        tc_subr_2,        STk_vector_ref},
  268.   {"vector-set!",        tc_subr_3,        STk_vector_set},
  269.   {"vector->list",        tc_subr_1,        STk_vector2list},
  270.   {"list->vector",        tc_subr_1,        STk_list2vector},
  271.   {"vector-fill!",        tc_subr_2,        STk_vector_fill},
  272.  
  273.   {"vector-copy",        tc_subr_1,        STk_vector_copy},        /* + */
  274.   {"vector-resize",        tc_subr_2,        STk_vector_resize},        /* + */
  275.  
  276.   /**** Section 6.9 ****/
  277.   {"procedure?",        tc_subr_1,        STk_procedurep},
  278.   {"apply",            tc_apply,        NULL},
  279.   {"map",            tc_lsubr,        STk_map},
  280.   {"for-each",            tc_lsubr,        STk_for_each},
  281.   {"force",            tc_subr_1,        STk_force},
  282.   {"call-with-current-continuation",        
  283.                      tc_call_cc,        NULL}, 
  284.  
  285.   {"promise?",              tc_subr_1,        STk_promisep},        /* + */
  286.   {"continuation?",        tc_subr_1,        STk_continuationp},        /* + */
  287.   {"dynamic-wind",        tc_subr_3,        STk_dynamic_wind},        /* + */
  288.   {"catch",            tc_fsubr,        STk_catch},            /* + */
  289.   {"procedure-body",        tc_subr_1,        STk_procedure_body},    /* + */
  290.  
  291.   /**** Section 6.10 ****/
  292.   {"input-port?",        tc_subr_1,        STk_input_portp},
  293.   {"output-port?",        tc_subr_1,        STk_output_portp},
  294.   {"current-input-port",    tc_subr_0,        STk_current_input_port},
  295.   {"current-output-port",   tc_subr_0,        STk_current_output_port},
  296.   {"with-input-from-file",  tc_subr_2,        STk_with_input_from_file},
  297.   {"with-output-to-file",   tc_subr_2,        STk_with_output_to_file},
  298.   {"open-input-file",        tc_subr_1,        STk_open_input_file},
  299.   {"open-output-file",        tc_subr_1,        STk_open_output_file},
  300.   {"close-input-port",        tc_subr_1,        STk_close_input_port},
  301.   {"close-output-port",        tc_subr_1,        STk_close_output_port},
  302.   {"read",            tc_subr_0_or_1, STk_read},
  303.   {"read-char",             tc_subr_0_or_1, STk_read_char},
  304.   {"peek-char",             tc_subr_0_or_1, STk_peek_char},
  305.   {"eof-object?",        tc_subr_1,        STk_eof_objectp},
  306.   {"char-ready?",        tc_subr_0_or_1, STk_char_readyp},
  307.   {"write",            tc_subr_1_or_2, STk_write},
  308.   {"display",            tc_subr_1_or_2, STk_display},
  309.   {"newline",            tc_subr_0_or_1, STk_newline},
  310.   {"write-char",        tc_subr_1_or_2, STk_write_char},
  311.   {"load",            tc_subr_1,        STk_scheme_load},
  312.  
  313.   {"open-file",            tc_subr_2,        STk_open_file},        /* + */
  314.   {"close-port",        tc_subr_1,        STk_close_port},        /* + */
  315.   {"read-line",            tc_subr_0_or_1, STk_read_line},        /* + */
  316.   {"flush",            tc_subr_0_or_1, STk_flush},            /* + */
  317.   {"try-load",            tc_subr_1,        STk_try_load},        /* + */
  318.   {"autoload",            tc_fsubr,        STk_autoload},        /* + */
  319.   {"autoload?",            tc_fsubr,        STk_autoloadp},        /* + */
  320. #ifdef USE_TK
  321.   {"when-port-readable",    tc_subr_1_or_2, STk_when_port_readable},    /* + */
  322.   {"when-port-writable",    tc_subr_1_or_2, STk_when_port_writable},    /* + */
  323. #endif
  324.   {"format",            tc_lsubr,        STk_format},        /* + */
  325.   {"error",            tc_lsubr,        STk_error},            /* + */
  326.   {"input-string-port?",    tc_subr_1,        STk_input_string_portp},    /* + */
  327.   {"output-string-port?",   tc_subr_1,        STk_output_string_portp},    /* + */
  328.   {"current-error-port",    tc_subr_0,        STk_current_error_port},    /* + */
  329.   {"open-input-string",        tc_subr_1,        STk_open_input_string},    /* + */
  330.   {"open-output-string",    tc_subr_0,        STk_open_output_string},    /* + */
  331.   {"get-output-string",        tc_subr_1,        STk_get_output_string},    /* + */
  332.   {"with-input-from-string",tc_subr_2,        STk_with_input_from_string},/* + */
  333.   {"with-output-to-string", tc_subr_1,        STk_with_output_to_string}, /* + */
  334.   {"read-from-string",        tc_subr_1,        STk_read_from_string},    /* + */
  335.  
  336.   /**** Section 6.11 ****/
  337.   {"keyword?",            tc_subr_1,        STk_keywordp},        /* + */
  338.   {"make-keyword",        tc_subr_1,        STk_make_keyword},        /* + */
  339.   {"keyword->string",        tc_subr_1,         STk_keyword2string},    /* + */
  340.   {"get-keyword",        tc_subr_2_or_3, STk_get_keyword},        /* + */
  341.  
  342.   /**** Section 6.12 ****/
  343. #ifdef USE_TK
  344.   {"widget->string",        tc_subr_1,        STk_widget2string},        /* + */
  345.   {"string->widget",        tc_subr_1,        STk_string2widget},        /* + */
  346.   {"tk-command?",        tc_subr_1,        STk_tk_commandp},        /* + */
  347.   {"widget-name",        tc_subr_1,        STk_widget_name},        /* + */
  348.   {"get-widget-data",        tc_subr_1,        STk_get_widget_data},    /* + */
  349.   {"set-widget-data!",        tc_subr_2,        STk_set_widget_data},    /* + */
  350. #endif
  351.  
  352.   /**** Section 6.13 ****/
  353.   {"environment?",        tc_subr_1,        STk_environmentp},        /* + */
  354.   {"the-environment",        tc_fsubr,        STk_the_environment},    /* + */
  355.   {"parent-environment",    tc_subr_1,        STk_parent_environment},    /* + */
  356.   {"global-environment",    tc_subr_0,        STk_global_environment},    /* + */
  357.   {"environment->list",        tc_subr_1,        STk_environment2list},    /* + */
  358.   {"procedure-environment", tc_subr_1,        STk_procedure_environment},    /* + */
  359.   {"symbol-bound?",        tc_subr_1_or_2, STk_symbol_boundp},        /* + */
  360.   {"eval",            tc_subr_1_or_2, STk_user_eval},        /* + */
  361.   {"eval-hook",            tc_subr_3,        STk_eval_hook},        /* + */
  362.  
  363.  
  364.   /**** Section 6.14 ****/
  365.   {"macro",            tc_fsubr,        STk_macro},            /* + */
  366.   {"macro?",            tc_subr_1,        STk_macrop},        /* + */
  367.   {"macro-expand",        tc_fsubr,        STk_macro_expand},        /* + */
  368.   {"macro-expand-1",        tc_fsubr,        STk_macro_expand_1},    /* + */
  369.   {"macro-body",        tc_subr_1,        STk_macro_body},        /* + */
  370.  
  371.   /**** Section 6.15 ****/
  372.   {"address-of",        tc_subr_1,        STk_address_of},        /* + */
  373.   {"address?",            tc_subr_1,        STk_addressp},        /* + */
  374.  
  375.   /**** Section 6.16 ****/
  376.   {"set-signal-handler!",   tc_subr_2,        STk_set_signal_handler},    /* + */
  377.   {"add-signal-handler!",   tc_subr_2,         STk_add_signal_handler},    /* + */
  378.   {"get-signal-handlers",   tc_subr_0_or_1, STk_get_signal_handlers},    /* + */
  379.  
  380.   /**** Section 6.17 ****/
  381.   {"getcwd",            tc_subr_0,        STk_getcwd},        /* + */
  382.   {"chdir",            tc_subr_1,        STk_chdir},            /* + */
  383.   {"getpid",            tc_subr_0,        STk_getpid},        /* + */
  384.   {"expand-file-name",        tc_subr_1,        STk_expand_file_name},    /* + */
  385.   {"canonical-path",        tc_subr_1,        STk_canonical_path},    /* + */
  386.   {"system",            tc_subr_1,        STk_system},        /* + */
  387.   {"getenv",            tc_subr_1,        STk_getenv},        /* + */
  388.   {"setenv!",            tc_subr_2,        STk_setenv},        /* + */
  389.   {"file-is-directory?",    tc_subr_1,        STk_file_is_directoryp},    /* + */
  390.   {"file-is-regular?",      tc_subr_1,        STk_file_is_regularp},    /* + */
  391.   {"file-is-readable?",     tc_subr_1,        STk_file_is_readablep},    /* + */
  392.   {"file-is-writable?",     tc_subr_1,        STk_file_is_writablep},    /* + */
  393.   {"file-is-executable?",   tc_subr_1,        STk_file_is_executablep},    /* + */
  394.   {"file-exists?",        tc_subr_1,        STk_file_existp},        /* + */
  395.   {"glob",            tc_lsubr,        STk_file_glob},        /* + */
  396.  
  397.   /**** Non standard procedures ****/
  398.   {"eval-string",        tc_subr_1_or_2, STk_eval_string},        /* + */
  399.   {"gc",            tc_subr_0,        STk_gc},            /* + */
  400.   {"gc-stats",            tc_subr_0,        STk_gc_stats},        /* + */
  401.   {"expand-heap",        tc_subr_1,        STk_expand_heap},        /* + */
  402.   {"version",            tc_subr_0,        STk_version},        /* + */
  403.   {"machine-type",        tc_subr_0,        STk_machine_type},        /* + */
  404.   {"random",            tc_subr_1,        STk_random},        /* + */
  405.   {"set-random-seed!",        tc_subr_1,        STk_set_random_seed},    /* + */
  406.   {"sort",            tc_subr_2,        STk_sort},            /* + */
  407.   {"dump",            tc_subr_1,        STk_dump},            /* + */
  408.   {"get-internal-info",        tc_subr_0,        STk_get_internal_info},    /* + */
  409.   {"time",            tc_fsubr,        STk_time},            /* + */
  410.   {"uncode",            tc_subr_1,        STk_uncode},        /* + */
  411.   {"exit",            tc_subr_0_or_1, STk_quit_interpreter},    /* + */
  412.  
  413. #ifdef USE_TK
  414.   {"trace-var",            tc_subr_2,        STk_trace_var},        /* + */
  415.   {"untrace-var",        tc_subr_1,        STk_untrace_var},        /* + */
  416. #endif
  417.  
  418.   /**** Undocumented primitives */
  419.   {"%get-eval-stack",        tc_subr_0,        STk_get_eval_stack},
  420.   {"%get-environment-stack",tc_subr_0,        STk_get_env_stack},
  421.   {"%find-cells",        tc_subr_1,        STk_find_cells},
  422.   {"%library-location",        tc_subr_0,        STk_library_location},
  423.  
  424. #ifdef USE_STKLOS
  425.   {"%init-stklos",        tc_subr_0,        STk_init_STklos},
  426. #endif
  427.  
  428. #ifdef USE_HASH
  429.   {"%init-hash",        tc_subr_0,        STk_init_hash},
  430. #endif
  431. #ifdef USE_SOCKET
  432.   {"%init-socket",        tc_subr_0,        STk_init_socket},
  433. #endif
  434. #ifdef USE_BLT
  435.  {"%init-blt",                tc_subr_0,        STk_init_blt},
  436. #endif 
  437. #ifdef USE_REGEXP
  438.  {"%init-regexp",            tc_subr_0,        STk_init_sregexp},
  439. #endif 
  440. #ifdef USE_PROCESS
  441.  {"%init-process",            tc_subr_0,        STk_init_process},
  442. #endif
  443. #ifdef USE_POSIX
  444.  {"%init-posix",            tc_subr_0,        STk_init_posix},
  445. #endif 
  446. #ifdef USE_HTML
  447.   {"%init-html",        tc_subr_0,        STk_init_html},
  448. #endif
  449. #if defined(USE_TK) && defined(USE_PIXMAP)
  450.   {"%init-pixmap",        tc_subr_0,        STk_init_pixmap},
  451. #endif
  452.   { "", 0, (SCM (*)()) NULL }
  453. };
  454.  
  455. void STk_init_primitives(void)
  456. {
  457.   register struct Primitive *p;
  458.   register SCM z;
  459.  
  460.   for (p = Scheme_primitives; *p->name; p++) {
  461.     /* Create a subr cell and store it in the obarray */
  462.     NEWCELL(z, p->type);
  463.     z->storage_as.subr.name = p->name;
  464.     z->storage_as.subr0.f   = p->fct;
  465.     VCELL(Intern(p->name))  =  z;
  466.   }
  467. }
  468.